lost data on array after "loop"

Hi Scripting guy,

I used one of the tutorials I found at this website on reading excel file sheet. Its working fine on my need only problem is I get an error on the  objFile.Write arrSheet part once I start writing  from array number 8 above.  Please help thanks in advance.

Option Explicit
Dim arrSheet, intCount, outFile, objFSO, objFile, MyEP, MyRS

't500 set assuming 16 sites max on channel Map explore t500 change to ubound value
arrSheet = ReadExcel( MyEP, MyRS, "B6", "L500", False ) 'set to true if you do not need headers

'setup to assign output of readexcel as loadfile name
x = split(loadfile,".")
filename = x(0)
WScript.Echo "check van = " & filename

'to write results to a file
outFile = "C:\Temp\simulation_function\"& file &".txt" 'feb 6

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(outFile,True) 
For intCount = 0 To UBound( arrSheet, 2 )
'to write to cmd use below wscript.Echo
'WScript.Echo arrSheet( 0, intCount ) & vbTab & arrSheet( 1, intCount )


objFile.Write arrSheet( 0, intCount ) & vbTab & arrSheet( 1, intCount ) & vbTab & arrSheet( 2, intCount ) & vbTab & arrSheet(3, intCount ) & vbTab & arrSheet( 4, 

intCount ) & vbTab & arrSheet( 5, intCount ) & vbTab & arrSheet( 6, intCount ) & vbTab &  arrSheet( 7, intCount ) & vbTab &  arrSheet( 8, intCount )  & vbCrLf


Next

objFile.Close
WScript.Echo "==============="


'=================================================
'===========Read excel function ==================
'=================================================
Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader )
' Function :  ReadExcel
' Version  :  3.00
' This function reads data from an Excel sheet without using MS-Office
'
' Arguments:
' myXlsFile   [string]   The path and file name of the Test Program to be read by the script
' mySheet     [string]   The name of the Channnel Map of the worksheet that needs to be read (could be many in an excel file)
' my1stCell   [string]   The index of the first cell to be read from channel map
' myLastCell  [string]   The index of the last cell to be read from channel map
' blnHeader   [boolean]  True if the first row in the sheet is a header
'
' Returns:
' The values read from the Excel sheet are returned in a two-dimensional
' array; the first dimension holds the columns, the second dimension holds
' the rows read from the Excel sheet.

Dim   arrData( ), i, j
Dim objExcel, objRS
Dim strHeader, strRange

Const adOpenForwardOnly = 0
Const adOpenKeyset      = 1
Const adOpenDynamic     = 2
Const adOpenStatic      = 3

' Define header parameter string for Excel object
If blnHeader Then
strHeader = "HDR=YES;"
Else
strHeader = "HDR=NO;"
End If



' Open the object for the Excel file
Set objExcel = CreateObject( "ADODB.Connection" )
' With IMEX=1 numbers won't be ignored; tip by Thomas Willig.
' Connection string updated by Marcel Ninkemper to open Excel 2007 (.xslx) files.
objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
           & myXlsFile & ";Extended Properties=""Excel 12.0;IMEX=1;" _
           & strHeader & """"

' Open a recordset object for the sheet and range
Set objRS = CreateObject( "ADODB.Recordset" )
strRange = mySheet & "$" & my1stCell & ":" & myLastCell
objRS.Open "Select * from [" & strRange & "]", objExcel, adOpenStatic

' Read the data from the Excel sheet
i = 0
Do Until objRS.EOF

' Stop reading when an empty row is encountered in the Excel sheet
If IsNull( objRS.Fields(0).Value ) Or Trim( objRS.Fields(0).Value ) = "" Then Exit Do


' Add a new row to the output array
ReDim Preserve arrData( objRS.Fields.Count - 1, i )  


' Copy the Excel sheet's row values to the array "row"
' IsNull test credits: Adriaan Westra
For j = 0 To objRS.Fields.Count - 1
If IsNull( objRS.Fields(j).Value ) Then
arrData( j, i ) = " test "
Else
arrData( j, i ) = Trim( objRS.Fields(j).Value )

End If
Next

' Move to the next row
objRS.MoveNext
' Increment the array "row" number
i = i + 1
Loop

' Return the results


' Close the file and release the objects
objRS.Close
objExcel.Close
Set objRS    = Nothing
Set objExcel = Nothing


ReadExcel = arrData



End Function


  • Edited by Mckulet Sunday, February 08, 2015 12:29 PM edited code
February 8th, 2015 3:29pm

This topic is archived. No further replies will be accepted.

Other recent topics Other recent topics